perm filename DDERIV.BCH[TIM,LSP]1 blob sn#666828 filedate 1982-07-06 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	Symbolic Derivative (2)
C00007 ENDMK
CāŠ—;
Symbolic Derivative (2)
This benchmark is a variant of the simple symbolic derivative program I
sent recently. The main change is that it is `table-driven.'  Instead of a
large COND that branches on the CAR of the expression, this program finds
the code that will take the derivative on the property list of the atom in
the CAR position. So, when the expression is (PLUS . <rest>), the code
stored under the atom PLUS with indicator DERIV will take <rest> and
return the derivative for PLUS. The way that MacLisp does this is with the
special form: (DEFUN (FOO BAR) ...). This is exactly like DEFUN with an
atomic name in that it expects an argument list and the compiler compiles
code, but the name of the function with that code is stored on the
property list of FOO under the indicator BAR, in this case. You may have
to do something like:

(DEFUN DPLUS (A) ...)
(PUTPROP 'PLUS 'DPLUS 'DERIV)

Here is the code:

(DECLARE (MAPEX T))	;causes MAPCAR's to open-code

(DEFUN DER1 (A) (LIST 'QUOTIENT (DERIV A) A))

(DEFUN (PLUS DERIV) (A)
       (CONS 'PLUS (MAPCAR 'DERIV A)))

(DEFUN (DIFFERENCE DERIV) (A)
       (CONS 'DIFFERENCE (MAPCAR 'DERIV 
				 A)))

(DEFUN (TIMES DERIV) (A)
       (LIST 'TIMES A 
	     (CONS 'PLUS (MAPCAR 'DER1 A))))

(DEFUN (QUOTIENT DERIV) (A)
       (LIST 'DIFFERENCE 
	     (LIST 'QUOTIENT 
		   (DERIV (CAR A)) 
		   (CADR A))
	     (LIST 'QUOTIENT 
		   (CAR A) 
		   (LIST 'TIMES
			 (CADR A)
			 (CADR A)
			 (DERIV (CADR A))))))

;;; FUNCALL (for the 1 argument case) can be defined as:
;;;	(DEFUN FUNCALL (F X)
;;;	 	(APPLY F (NCONS X)))
;;;
;;; Using macros FUNCALL is (in the general case):
;;;  	(DEFMACRO FUNCALL (F . X)
;;;		`(APPLY ,F (LIST . ,X)))

 (DEFUN DERIV (A)
	(COND 
	 ((ATOM A)
	  (COND ((EQ A 'X) 1) (T 0)))
	 (T (LET ((DERIV (GET (CAR A) 'DERIV)))
		 (COND (DERIV (FUNCALL DERIV (CDR A)))
		       (T 'ERROR))))))

(DEFUN RUN ()
 (DECLARE (FIXNUM I))
 (DO ((I 0 (1+ I)))
     ((= I 1000.))
     (DERIV '(PLUS (TIMES 3 X X) (TIMES A X X) (TIMES B X) 5))
     (DERIV '(PLUS (TIMES 3 X X) (TIMES A X X) (TIMES B X) 5))
     (DERIV '(PLUS (TIMES 3 X X) (TIMES A X X) (TIMES B X) 5))
     (DERIV '(PLUS (TIMES 3 X X) (TIMES A X X) (TIMES B X) 5))
     (DERIV '(PLUS (TIMES 3 X X) (TIMES A X X) (TIMES B X) 5))))

Here is a sample run on SAIL in MacLisp:
(fasload dderiv)
(timit)

Timing performed on Tuesday 07/06/82 at 16:01:46.
Cpu Time = 3.12
Elapsed Time = 66.9
Wholine Time = 39.233333
GC Time = 18.734
Load Average Before  = 1.03375137
Load Average After   = 1.3326118
Average Load Average = 1.18318158

Refer to this benchmark as DDERIV.
			-rpg-